home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 1 / Cream of the Crop 1.iso / PROGRAM / BTV115.ARJ / BTRV6.PAS next >
Pascal/Delphi Source File  |  1992-02-23  |  9KB  |  216 lines
  1. UNIT BTRV6;
  2.  
  3. {****************************************************************************}
  4. {*   REVISION HISTORY                                                       *}
  5. {*                                                                          *}
  6. {*  Date     Who  What                                                      *}
  7. {* ======================================================================== *}
  8. {* 02/01/92  RWH  Changed all instances of Data Buffer Length from Integer  *}
  9. {*                to Word so variable length records can be up to 64K.      *}
  10. {****************************************************************************}
  11.  
  12. INTERFACE
  13.  
  14. {$R-}    {Range checking off}
  15. {$B+}    {Boolean complete evaluation on}
  16. {$S+}    {Stack checking on}
  17. {$N-}    {No numeric coprocessor}
  18.  
  19.  
  20. {+--------------------------------------------------------------------------+}
  21. {                                                                            }
  22. {  Module Name: BTRV6.PAS                                                    }
  23. {                                                                            }
  24. {  Description: This is the Btrieve interface for Turbo Pascal 6.0 (MS-DOS). }
  25. {      This routine sets up the parameter block expected by                  }
  26. {      Btrieve, and issues interrupt 7B.  It should be compiled              }
  27. {      with the $V- switch so that runtime checks will not be                }
  28. {      performed on the variable parameters.                                 }
  29. {                                                                            }
  30. {  Synopsis:   STAT := BTRV (OP, POS.START, DATA.START, DATALEN,             }
  31. {                            KBUF.START, KEY);                               }
  32. {               where                                                        }
  33. {         OP is an integer,                                                  }
  34. {         POS is a 128 byte array,                                           }
  35. {         DATA is an untyped parameter for the data buffer,                  }
  36. {         DATALEN is the integer length of the data buffer,                  }
  37. {         KBUF is the untyped parameter for the key buffer,                  }
  38. {          and KEY is an integer.                                            }
  39. {                                                                            }
  40. {  Returns:   Btrieve status code (see Appendix B of the Btrieve Manual).    }
  41. {                                                                            }
  42. {  Note:   The Btrieve manual states that the 2nd, 3rd, and 5th              }
  43. {      parameters be declared as variant records, with an integer            }
  44. {      type as one of the variants (used only for Btrieve calls),            }
  45. {      as is shown in the example below.  This is supported, but             }
  46. {      the restriction is no longer necessary.  In other words, any          }
  47. {      variable can be sent in those spots as long as the variable           }
  48. {      uses the correct amount of memory so Btrieve does not                 }
  49. {      overwrite other variables.                                            }
  50. {                                                                            }
  51. {         var DATA = record case boolean of                                  }
  52. {            FALSE: ( START: integer );                                      }
  53. {            TRUE:  ( EMPLOYEE_ID: 0..99999;                                 }
  54. {                EMPLOYEE_NAME: packed array[1..50] of char;                 }
  55. {                SALARY: real;                                               }
  56. {                DATA_OF_HIRE: DATE_TYPE );                                  }
  57. {            end;                                                            }
  58. {                                                                            }
  59. {      There should NEVER be any string variables declared in the            }
  60. {      data or key records, because strings store an extra byte for          }
  61. {      the length, which affects the total size of the record.               }
  62. {                                                                            }
  63. {                                                                            }
  64. {+--------------------------------------------------------------------------+}
  65.  
  66. USES
  67.    Dos;
  68.  
  69. CONST
  70.   BTR_INT        : Byte = $7B;
  71.  
  72. Function BTRV(    OP       : Integer;
  73.               var POS,
  74.                   DATA;
  75.               var DATALEN  : Word;
  76.               var KBUF;
  77.                   KEY      : Integer
  78.               ): Integer;
  79.  
  80. {============================================================================}
  81. IMPLEMENTATION
  82.  
  83.  
  84. Function BTRV(    OP       : Integer;
  85.               var POS,
  86.                   DATA;
  87.               var DATALEN  : Word;
  88.               var KBUF;
  89.                   KEY      : Integer
  90.               ): Integer;
  91.  
  92.   const
  93.     VAR_ID         = $6176;   {id for variable length records - 'va'}
  94.     BTR2_INT       = $2F;
  95.     BTR_OFFSET     = $0033;
  96.     MULTI_FUNCTION = $AB;
  97.  
  98. {  ProcId is used for communicating with the Multi Tasking Version of        }
  99. {  Btrieve. It contains the process id returned from BMulti and should       }
  100. {  not be changed once it has been set.                                      }
  101. {                                                                            }
  102.      ProcId : integer = 0;       { initialize to no process id }
  103.      MULTI  : boolean = false;   { set to true if BMulti is loaded }
  104.      VSet   : boolean = false;   { set to true if we have checked for BMulti }
  105.  
  106.   type
  107.     ADDR32 = record               {32 bit address}
  108.         OFFSET : integer;
  109.         SEGMENT: integer;
  110.       end;
  111.  
  112.       BTR_PARMS = record
  113.         USER_BUF_ADDR  : ADDR32;  {data buffer address}
  114.         USER_BUF_LEN   : Word;    {data buffer length}
  115.         USER_CUR_ADDR  : ADDR32;  {currency block address}
  116.         USER_FCB_ADDR  : ADDR32;  {file control block address}
  117.         USER_FUNCTION  : integer; {Btrieve operation}
  118.         USER_KEY_ADDR  : ADDR32;  {key buffer address}
  119.         USER_KEY_LENGTH: BYTE;    {key buffer length}
  120.         USER_KEY_NUMBER: BYTE;    {key number}
  121.         USER_STAT_ADDR : ADDR32;  {return status address}
  122.         XFACE_ID       : integer; {language interface id}
  123.       end;
  124.  
  125.   var
  126.     STAT : integer;             {Btrieve status code}
  127.     XDATA: BTR_PARMS;           {Btrieve parameter block}
  128.     REGS : Dos.Registers;       {register structure used on interrrupt call}
  129.     DONE : boolean;
  130.  
  131.   begin
  132.     REGS.AX := $3500 + BTR_INT;
  133.     INTR ($21, REGS);
  134.  
  135.     if (REGS.BX <> BTR_OFFSET) then         {make sure Btrieve is installed}
  136.       STAT := 20
  137.  
  138.     else
  139.     begin
  140.       if (not VSet) then   {if we haven't checked for Multi-User version}
  141.       begin
  142.         REGS.AX := $3000;
  143.         INTR ($21, REGS);
  144.  
  145.         if ((REGS.AX AND $00FF) >= 3) then
  146.         begin
  147.           VSet := true;
  148.           REGS.AX := MULTI_FUNCTION * 256;
  149.           INTR (BTR2_INT, REGS);
  150.           MULTI := ((REGS.AX AND $00FF) = $004D);
  151.         end
  152.         else
  153.             MULTI := false;
  154.       end;
  155.                         {make normal btrieve call}
  156.       with XDATA do
  157.       begin
  158.         USER_BUF_ADDR.SEGMENT := SEG (DATA);
  159.         USER_BUF_ADDR.OFFSET := OFS (DATA); {set data buffer address}
  160.         USER_BUF_LEN := DATALEN;
  161.         USER_FCB_ADDR.SEGMENT := SEG (POS);
  162.         USER_FCB_ADDR.OFFSET := OFS (POS);        {set FCB address}
  163.         USER_CUR_ADDR.SEGMENT := USER_FCB_ADDR.SEGMENT; {set cur seg}
  164.         USER_CUR_ADDR.OFFSET := USER_FCB_ADDR.OFFSET+38;{set cur ofs}
  165.         USER_FUNCTION := OP;        {set Btrieve operation code}
  166.         USER_KEY_ADDR.SEGMENT := SEG (KBUF);
  167.         USER_KEY_ADDR.OFFSET := OFS (KBUF);  {set key buffer address}
  168.         USER_KEY_LENGTH := 255;        {assume its large enough}
  169.         USER_KEY_NUMBER := KEY;            {set key number}
  170.         USER_STAT_ADDR.SEGMENT := SEG (STAT);
  171.         USER_STAT_ADDR.OFFSET := OFS (STAT);     {set status address}
  172.         XFACE_ID := VAR_ID;              {set lamguage id}
  173.       end;
  174.  
  175.       REGS.DX := OFS (XDATA);
  176.       REGS.DS := SEG (XDATA);
  177.  
  178.       if (NOT MULTI) then           {MultiUser version not installed}
  179.           INTR (BTR_INT, REGS)
  180.  
  181.       else
  182.       begin
  183.         DONE := FALSE;
  184.  
  185.         repeat
  186.           REGS.BX := ProcId;
  187.           REGS.AX := 1;
  188.  
  189.           if (REGS.BX <> 0) then
  190.             REGS.AX := 2;
  191.  
  192.           REGS.AX := REGS.AX + (MULTI_FUNCTION * 256);
  193.           INTR (BTR2_INT, REGS);
  194.  
  195.           if ((REGS.AX AND $00FF) = 0) then
  196.             DONE := TRUE
  197.           else
  198.           begin
  199.             REGS.AX := $0200;
  200.             INTR ($7F, REGS);
  201.             DONE := FALSE;
  202.           end;
  203.         until (DONE);
  204.  
  205.         if (ProcId = 0) then
  206.           ProcId := REGS.BX;
  207.       end;
  208.  
  209.       DATALEN := XDATA.USER_BUF_LEN;
  210.     end;
  211.  
  212.     BTRV := STAT;
  213.   end;
  214.  
  215. End.
  216.